home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / e-lang / bguiv412.lha / BGUI_Ev41_2 / sources / TestPalette.e < prev    next >
Text File  |  1996-05-02  |  11KB  |  271 lines
  1. /*
  2. **      TestPalette.e
  3. **
  4. **      (C) Copyright 1995 Jaba Development.
  5. **      (C) Copyright 1995 Jan van den Baard.
  6. **          All Rights Reserved.
  7. **
  8. **      Heavely modified by Dominique Dutoit, 5/1/96
  9. */
  10.  
  11. OPT OSVERSION=37
  12. OPT PREPROCESS
  13.  
  14. MODULE 'libraries/bgui',
  15.        'libraries/bgui_macros',
  16.        'libraries/gadtools',
  17.        'bgui',
  18.        'tools/boopsi',
  19.        'tools/installhook',
  20.        'utility/tagitem',
  21.        'utility/hooks',
  22.        'intuition/classes',
  23.        'intuition/classusr',
  24.        'intuition/gadgetclass',
  25.        'intuition/intuition',
  26.        'intuition',
  27.        'palette_bgui',
  28.        'gadgets/palette_bgui',
  29.        'exec/types',
  30.        'amigalib/boopsi'
  31.  
  32. DEF     paletteclass:PTR TO iclass, mybuttonclass:PTR TO iclass
  33.  
  34. /*
  35.  *      Object ID's.
  36.  */
  37. CONST   ID_QUIT= 1,
  38.         ID_FRAME=2,
  39.         ID_SFRAME=3,
  40.         ID_LABEL=4,
  41.         ID_SLABEL=5
  42.  
  43. /*
  44.  *  The button we use is a very simple subclass from the
  45.  *  BGUI buttonclass to accept only drops from the four
  46.  *  paletteclass objects in this demo or from other palette
  47.  *  class objects from another task or window when they have
  48.  *  the same ID as we use here.
  49.  */
  50. PROC mybuttondispatch( cl:PTR TO iclass, obj:PTR TO object, bmsg )
  51.     DEF rc, pen, tag, i, j, imsg:msg
  52.     DEF gad:PTR TO gadget, dragmsg:PTR TO bmdragmsg, dragpnt:PTR TO bmdragpoint
  53.  
  54.     imsg := bmsg
  55.     i := imsg.methodid
  56.     SELECT i
  57.         CASE    BASE_DRAGQUERY
  58.                 /*
  59.                  *  We only accept drops from our paletteclass objects.
  60.                  *  The test here is a bit simple but this way it does
  61.                  *  allow for drops from another task. Just run this demo
  62.                  *  twice and DragNDrop from one window to another.
  63.                  */
  64.                 dragpnt := imsg
  65.                 gad := dragpnt.source
  66.                 IF ( gad.gadgetid >= ID_FRAME ) AND ( gad.gadgetid <= ID_SLABEL )
  67.                     rc := BQR_ACCEPT
  68.                 ELSE
  69.                     rc := BQR_REJECT
  70.                 ENDIF
  71.  
  72.         CASE    BASE_DROPPED
  73.                 /*
  74.                  *  Get the pen from the object.
  75.                  */
  76.                 dragmsg := imsg
  77.                 GetAttr( PALETTE_CURRENTCOLOR, dragmsg.source, {pen} )
  78.  
  79.                 /*
  80.                  *  Let's see what has been dropped...
  81.                  */
  82.                 gad := dragmsg.source
  83.                 j := gad.gadgetid
  84.                 SELECT j
  85.                     CASE    ID_FRAME
  86.                             tag := FRM_BACKPEN
  87.  
  88.                     CASE    ID_SFRAME
  89.                             tag := FRM_SELECTEDBACKPEN
  90.  
  91.                     CASE    ID_LABEL
  92.                             tag := LAB_PEN
  93.  
  94.                     CASE    ID_SLABEL
  95.                             tag := LAB_SELECTEDPEN
  96.  
  97.                 ENDSELECT
  98.  
  99.                 /*
  100.                  *  Set the pen. The superclass will force
  101.                  *  a refresh on the object when the drop has
  102.                  *  been made.
  103.                  */
  104.                 SetAttrsA( obj, [ tag, pen, TAG_END ] )
  105.                 rc := 1
  106.  
  107.         DEFAULT
  108.                 rc := doSuperMethodA( cl, obj, bmsg )
  109.  
  110.     ENDSELECT
  111. ENDPROC rc
  112.  
  113. /*
  114.  *  Setup our button class.
  115.  */
  116. PROC makemybuttonclass()
  117.     DEF cl:PTR TO iclass, super:PTR TO iclass
  118.  
  119.     /*
  120.      * Get a pointer to our superclass.
  121.      */
  122.     IF ( super := BgUI_GetClassPtr( BGUI_BUTTON_GADGET ))
  123.         /*
  124.          * Make our class.
  125.          */
  126.          IF ( cl := MakeClass( NIL, NIL, super, 0, 0 ))
  127.              /*
  128.               * Setup our dispatcher.
  129.               */
  130.             installhook( cl.dispatcher, {mybuttondispatch} )
  131.          ENDIF
  132.      ENDIF
  133. ENDPROC cl
  134.  
  135. PROC main()
  136.      DEF window
  137.      DEF wo_window, go_quit, go_b, go_pal[ 4 ]:ARRAY OF LONG
  138.      DEF signal = 0, rc, a
  139.      DEF defpens[ 4 ]:ARRAY OF LONG
  140.      DEF running = TRUE
  141.  
  142.      defpens := [ 0, 3, 1, 1]
  143.  
  144.      /*
  145.      **      Open BGUI.
  146.      **/
  147.      IF ( bguibase := OpenLibrary( BGUINAME, BGUIVERSION ))
  148.          /*
  149.           * Initialize the paletteclass.
  150.           */
  151.           IF ( bguipalettebase := OpenLibrary( BGUIPALETTENAME, BGUIPALETTEVERSION ))
  152.               paletteclass := PaLETTE_GetClassPtr()
  153.              /*
  154.               * And our drop-buton class.
  155.               */
  156.               IF ( mybuttonclass := makemybuttonclass() )
  157.                   /*
  158.                    * I assume a depth of three
  159.                    * (8 colors) here for simplicity.
  160.                    */
  161.                    FOR a := 0 TO 3
  162.                        go_pal[ a ] := NewObjectA( paletteclass, NIL,
  163.                                                   [ FRM_TYPE,             FRTYPE_BUTTON,
  164.                                                     FRM_RECESSED,         TRUE,
  165.                                                     PALETTE_DEPTH,        3,
  166.                                                     PALETTE_CURRENTCOLOR, defpens[ a ],
  167.                                                     GA_ID,                a + 2,
  168.                                                     BT_DRAGOBJECT,        TRUE,
  169.                                                     TAG_END ] )
  170.                    ENDFOR
  171.                    /*
  172.                    **  Create the window object.
  173.                    **/
  174.                    wo_window := WindowObject,
  175.                          WINDOW_TITLE,           'PaletteClass Demo',
  176.                          WINDOW_SMARTREFRESH,    TRUE,
  177.                          WINDOW_RMBTRAP,         TRUE,
  178.                          WINDOW_AUTOASPECT,      TRUE,
  179.                          WINDOW_AUTOKEYLABEL,    TRUE,
  180.                          WINDOW_IDCMP,           IDCMP_MOUSEMOVE,
  181.                          WINDOW_MASTERGROUP,
  182.                              VGroupObject, HOffset( 4 ), VOffset( 4 ), Spacing( 4 ),
  183.                                  GROUP_BACKFILL,    SHINE_RASTER,
  184.                                      StartMember,
  185.                                          InfoFixed( NIL, '\ecAs you can see the colors of the below button\nare normal but when you change the colors with\nthe palette objects the colors of the button change.\n\nYou can also pickup the color and drop it onto the\nbutton. \ebDragNDrop\en in action.', NIL, 8 ),
  186.                                      EndMember,
  187.                                      StartMember,
  188.                                          HGroupObject, HOffset( 4 ), VOffset( 4 ), Spacing( 4 ),
  189.                                              FRM_TYPE,          FRTYPE_BUTTON,
  190.                                              FRM_RECESSED,      TRUE,
  191.                                              StartMember, go_b := NewObjectA( mybuttonclass, NIL,
  192.                                                                              [ FRM_TYPE,         FRTYPE_BUTTON,
  193.                                                                                LAB_LABEL,        'Palette Demo',
  194.                                                                                BT_DROPOBJECT,    TRUE,
  195.                                                                                TAG_END] ), EndMember,
  196.                                          EndObject, FixMinHeight,
  197.                                      EndMember,
  198.                                      StartMember,
  199.                                          HGroupObject, HOffset( 4 ), VOffset( 4 ), Spacing( 4 ),
  200.                                              FRM_TYPE,           FRTYPE_BUTTON,
  201.                                              FRM_RECESSED,       TRUE,
  202.                                              StartMember,
  203.                                                  VGroupObject, Spacing( 4 ),
  204.                                                      LAB_LABEL,  'Background:',
  205.                                                      LAB_PLACE,  PLACE_ABOVE,
  206.                                                      StartMember, go_pal[ 0 ], EndMember,
  207.                                                      StartMember, go_pal[ 1 ], EndMember,
  208.                                                  EndObject,
  209.                                              EndMember,
  210.                                              StartMember,
  211.                                                  VGroupObject, Spacing( 4 ),
  212.                                                      LAB_LABEL,  'Label:',
  213.                                                      LAB_PLACE,  PLACE_ABOVE,
  214.                                                      StartMember, go_pal[ 2 ], EndMember,
  215.                                                      StartMember, go_pal[ 3 ], EndMember,
  216.                                                  EndObject,
  217.                                              EndMember,
  218.                                          EndObject,
  219.                                      EndMember,
  220.                                      StartMember,
  221.                                          HGroupObject,
  222.                                              VarSpace( DEFAULT_WEIGHT ),
  223.                                              StartMember, go_quit := KeyButton( '_Quit', ID_QUIT ), EndMember,
  224.                                              VarSpace( DEFAULT_WEIGHT ),
  225.                                          EndObject, FixMinHeight,
  226.                                      EndMember,
  227.                              EndObject,
  228.                    EndObject
  229.  
  230.                    /*
  231.                    **      Object created OK?
  232.                    **/
  233.                    IF ( wo_window )
  234.                       AddMap( go_pal[ 0 ], go_b, [ PALETTE_CURRENTCOLOR, FRM_BACKPEN,        TAG_END ] )
  235.                       AddMap( go_pal[ 1 ], go_b, [ PALETTE_CURRENTCOLOR, FRM_SELECTEDBACKPEN,TAG_END ] )
  236.                       AddMap( go_pal[ 2 ], go_b, [ PALETTE_CURRENTCOLOR, LAB_PEN,            TAG_END ] )
  237.                       AddMap( go_pal[ 3 ], go_b, [ PALETTE_CURRENTCOLOR, LAB_SELECTEDPEN,    TAG_END ] )
  238.                       IF ( window := WindowOpen( wo_window ) )
  239.                          GetAttr( WINDOW_SIGMASK, wo_window, {signal} )
  240.                              WHILE running = TRUE
  241.                                    Wait( signal )
  242.                                    WHILE ( rc := HandleEvent( wo_window )) <> WMHI_NOMORE
  243.                                          SELECT rc
  244.                                                 CASE    WMHI_CLOSEWINDOW
  245.                                                         running := FALSE
  246.                                                 CASE    ID_QUIT
  247.                                                         running := FALSE
  248.                                          ENDSELECT
  249.                                    ENDWHILE
  250.                              ENDWHILE
  251.                       ELSE
  252.                          WriteF( 'Unable to open the window\n' )
  253.                       ENDIF
  254.                       DisposeObject( wo_window )
  255.                    ELSE
  256.                       WriteF( 'Unable to create a window object\n' )
  257.                    ENDIF
  258.                    FreeClass( mybuttonclass )
  259.               ELSE
  260.                   WriteF( 'Unable to create custom class\n' )
  261.               ENDIF
  262.               CloseLibrary( bguipalettebase )
  263.           ELSE
  264.               WriteF( 'Unable to open gadgets/palette_bgui.gadget\n' )
  265.           ENDIF
  266.           CloseLibrary(bguibase)
  267.      ELSE
  268.          WriteF( 'Unable to open the bgui.library\n' )
  269.      ENDIF
  270. ENDPROC NIL
  271.